home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Amiga Format CD 52
/
Amiga Format AFCD52 (Issue 136, May 2000).iso
/
-in_the_mag-
/
multitasking
/
priorities
/
steamywindows
/
steamywindows.mod
< prev
next >
Wrap
Text File
|
2000-03-05
|
8KB
|
272 lines
(* --------------------------------------------------------------------------
:Program. SteamyWindows.mod
:Contents. raises the priority of the active window's task (comdity)
:Author. Franz Schwarz
:Copyright. Freeware (freely distributable, copyrighted software)
:Language. Oberon-2
:Translator. Amiga Oberon 3.00
:History. v1.0 26.10.93 [fSchwarz]
:Address. Mühlenstraße 2, D-78591 Durchhausen, Germany / R.F.A.
:Address. uucp: Franz_Schwarz@mil.ka.sub.org - Fido: 2:2476/506.18
:Remark. Requires OS3.0 interface modules update by hartmut Goebel
:Remark. Amiga-Oberon 3.00 checks string pointers to be even if
:Remark. OddChk is enabled; thus don't compile with OddChk.
:Usage. SteamyWindows (CLI or wbstart) no args
-------------------------------------------------------------------------- *)
MODULE SteamyWindows;
IMPORT
co: Commodities, e: Exec, I: Intuition, d: Dos, H: Hardware,
o: OberonLib, y: SYSTEM;
CONST
verTag = "\000$VER: SteamyWindows 1.0 (26.10.93) © Franz_Schwarz@mil.ka.sub.org - Freeware";
CONST
true = TRUE; false = FALSE; (* adapt to common lower case CONST style *)
(* ** Interface module bug fixes: ** *)
VAR
coBase: e.LibraryPtr;
(* CxBroker err parameter register mismatch in Commodities.mod! *)
PROCEDURE CxBroker {coBase, -36} (VAR nb{8}: co.NewBroker;
err{0} : UNTRACED POINTER TO LONGINT): co.CxObjPtr;
CONST
unique = 0; (* misdefinition in Commodities.mod *)
CONST
cnb = co.NewBroker (co.nbVersion, y.ADR ("SteamyWindows"), y.ADR (verTag[7]),
y.ADR ("Raises the priority of the active window's task"),
{unique}, {}, 0, NIL, 0);
cfakenb = co.NewBroker (co.nbVersion, y.ADR ("Angie"), y.ADR (verTag[7]),
y.ADR ("Fake broker to exclude usage of Angie"),
{unique}, {}, 0, NIL, 0);
VAR
active : BOOLEAN;
nb : co.NewBroker;
fakenb : co.NewBroker;
br : co.CxObjPtr;
fakebr : co.CxObjPtr;
VAR
vblanksig: INTEGER;
oldwin : I.WindowPtr;
win : I.WindowPtr;
PROCEDURE VBlankSignaller * (a5{9}: e.APTR): LONGINT;
(* $SaveRegs+ $StackChk- *)
BEGIN
y.SETREG (13, a5);
oldwin := win; win := I.int.activeWindow;
IF oldwin # win THEN
e.Signal (o.Me, LONGSET {vblanksig-1});
END;
RETURN 0; (* set Z flag *)
END VBlankSignaller;
(* $StackChk= *)
CONST
cvblint = e.Interrupt (NIL, NIL, e.interrupt, -100, y.ADR ("SteamyWindows Snooper"),
NIL, y.VAL (e.PROC, VBlankSignaller));
VAR
vblint: e.Interrupt;
PROCEDURE ActivateBroker (b: BOOLEAN);
VAR
lb: LONGINT;
BEGIN
IF b THEN lb := -1; ELSE lb := 0; END;
IF co.ActivateCxObj (br, lb) = e.false THEN END;
active := b;
END ActivateBroker;
VAR
OldPri : INTEGER;
IncTask: e.TaskPtr;
CONST
invalidPri = 4000H;
incPri = 4001H;
PROCEDURE SecureSetTaskPri (task: e.TaskPtr; pri: INTEGER): INTEGER;
VAR
t: e.TaskPtr;
r: INTEGER;
BEGIN
r := invalidPri;
IF (task = NIL) OR (pri = invalidPri) THEN RETURN r; END;
e.Disable ();
LOOP
t := e.exec.taskReady.head;
WHILE (t.node.succ # NIL) & (t # task) DO t := t.node.succ; END;
IF t.node.succ # NIL THEN EXIT; END;
t := e.exec.taskWait.head;
WHILE (t.node.succ # NIL) & (t # task) DO t := t.node.succ; END;
EXIT;
END;
IF (t.node.succ # NIL) & (e.FindTask (NIL) # t) THEN
IF pri = incPri THEN
pri := LONG (t.node.pri)+1;
ELSE
IF pri+1 # t.node.pri THEN pri := invalidPri; END;
END;
IF pri # invalidPri THEN
IF pri > MAX (SHORTINT) THEN pri := MAX (SHORTINT); END;
IF pri < MIN (SHORTINT) THEN pri := MIN (SHORTINT); END;
r := e.SetTaskPri (t, SHORT (pri));
END;
END;
e.Enable ();
RETURN r;
END SecureSetTaskPri;
PROCEDURE Init();
BEGIN
coBase := co.base;
IF coBase = NIL THEN HALT (20); END;
nb := cnb;
fakenb := cfakenb;
nb.port := e.CreateMsgPort();
fakenb.port := e.CreateMsgPort();
IF (nb.port = NIL) OR (fakenb.port = NIL) THEN HALT (20); END;
br := CxBroker (nb, NIL);
fakebr := CxBroker (fakenb, NIL);
IF (br = NIL) OR (fakebr = NIL) THEN HALT (20); END;
vblanksig := e.AllocSignal (-1) + 1;
IF vblanksig = 0 THEN HALT (20); END;
vblint := cvblint;
vblint.data := y.REG (13);
e.AddIntServer (H.vertb, y.ADR (vblint));
ActivateBroker (true);
END Init;
PROCEDURE CleanUp();
VAR
msg: e.MessagePtr;
BEGIN
IF vblint.code # NIL THEN
e.RemIntServer (H.vertb, y.ADR (vblint)); vblint.code := NIL;
END;
y.SETREG (0, SecureSetTaskPri (IncTask, OldPri)); IncTask := NIL;
e.FreeSignal (vblanksig-1); vblanksig := 0;
co.DeleteCxObjAll (br); br := NIL;
co.DeleteCxObjAll (fakebr); fakebr := NIL;
IF nb.port # NIL THEN
LOOP
msg := e.GetMsg (nb.port);
IF msg = NIL THEN EXIT; END;
e.ReplyMsg (msg);
END;
END;
e.DeleteMsgPort (nb.port); nb.port := NIL;
IF fakenb.port # NIL THEN
LOOP
msg := e.GetMsg (fakenb.port);
IF msg = NIL THEN EXIT; END;
e.ReplyMsg (msg);
END;
END;
e.DeleteMsgPort (fakenb.port); fakenb.port := NIL;
IF o.Result > 5 THEN I.DisplayBeep (NIL); END;
END CleanUp;
PROCEDURE ChangePri ();
VAR
newtask: e.TaskPtr;
lk : LONGINT;
w : I.WindowPtr;
tmpport: e.MsgPortPtr;
BEGIN
lk := I.LockIBase (0);
w := I.int.activeWindow;
IF active THEN
newtask := NIL;
e.Disable();
IF w # NIL THEN
tmpport := w.userPort;
IF (y.VAL (LONGSET, tmpport) * LONGSET {0,31} = LONGSET {}) &
(tmpport # NIL) & (e.public IN e.TypeOfMem (tmpport)) &
(e.public IN e.TypeOfMem (y.ADR (tmpport.msgList))) THEN
newtask := tmpport.sigTask;
END;
END;
e.Enable();
IF newtask # IncTask THEN
y.SETREG (0, SecureSetTaskPri (IncTask, OldPri));
IncTask := newtask;
OldPri := SecureSetTaskPri (IncTask, incPri);
IF OldPri = invalidPri THEN IncTask := NIL; END;
END;
ELSE
y.SETREG (0, SecureSetTaskPri (IncTask, OldPri)); IncTask := NIL;
END;
I.UnlockIBase (lk);
END ChangePri;
PROCEDURE Server ();
VAR
flgs: LONGSET;
msg : e.APTR;
msgtype: LONGSET;
msgid : LONGINT;
BEGIN
LOOP
flgs := e.Wait (LONGSET {d.ctrlC, nb.port.sigBit, fakenb.port.sigBit,
vblanksig-1});
IF vblanksig-1 IN flgs THEN
ChangePri();
END;
IF nb.port.sigBit IN flgs THEN
LOOP
msg := e.GetMsg (nb.port);
IF msg = NIL THEN EXIT; END;
msgtype := co.CxMsgType (msg);
msgid := co.CxMsgID (msg);
e.ReplyMsg (msg);
IF msgtype = LONGSET {co.cxmCommand} THEN
CASE msgid OF
co.cmdKill:
HALT (0); |
co.cmdEnable:
ActivateBroker (true);
win := NIL; (* this is an atomic operation! *) |
co.cmdDisable:
ActivateBroker (false);
y.SETREG (0, SecureSetTaskPri (IncTask, OldPri)); IncTask := NIL;
ELSE END;
END;
END; (* LOOP *)
END;
IF fakenb.port.sigBit IN flgs THEN
LOOP
msg := e.GetMsg (fakenb.port);
IF msg = NIL THEN EXIT; END;
e.ReplyMsg (msg);
IF co.ActivateCxObj (fakebr, e.false) = e.false THEN END;
END;
END;
IF d.ctrlC IN flgs THEN HALT (5); END;
END;
END Server;
BEGIN
Init();
Server();
CLOSE
CleanUp();
END SteamyWindows.